home *** CD-ROM | disk | FTP | other *** search
/ SunSoft Catalyst CDWARE 1996 May to August / Catalyst CDWARE 1996 May to August.iso / .products / .bin / httpd / Solaris_x86 / more_info.pl < prev    next >
Perl Script  |  1996-04-02  |  5KB  |  194 lines

  1. #!./perl 
  2.  
  3.  
  4. # ------------------------------------------------------------
  5.  
  6. # This script was baseed on the generic_mailer2.pl, by phil hooper (pjh@netcom.com)
  7. # It was modified for the query engine behind the Catalyst Interlink Solaris Product Expo
  8. # Dec 14, 1994 Marc Sacoolas
  9.  
  10. sub get_request {
  11.  
  12.     # Subroutine get_request reads the POST or GET form request from STDIN
  13.     # into the variable  $request, and then splits it into its
  14.     # name=value pairs in the associative array %rqpairs.
  15.     # The number of bytes is given in the environment variable
  16.     # CONTENT_LENGTH which is automatically set by the request generator.
  17.  
  18.     # Encoded HEX values and spaces are decoded in the values at this
  19.     # stage.
  20.  
  21.     # $request will contain the RAW request. N.B. spaces and other
  22.     # special characters are not handler in the name field.
  23.  
  24.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  25.     read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
  26.     } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
  27.     $request = $ENV{'QUERY_STRING'};
  28.     }
  29.  
  30.  
  31.     @names = &url_decode(split(/[&=]/, $request));
  32.     %rqpairs = @names;
  33.  
  34. }
  35.  
  36. sub url_decode {
  37.  
  38. #    Decode a URL encoded string or array of strings 
  39. #        + -> space
  40. #        %xx -> character xx
  41.  
  42.  
  43.     foreach (@_) {
  44.     tr/+/ /;
  45.     s/%(..)/pack("c",hex($1))/ge;
  46.     }
  47.     @_;
  48. }
  49.  
  50. sub html_header {
  51.  
  52.     # Subroutine html_header sends to Standard Output the necessary
  53.     # material to form an HHTML header for the document to be
  54.     # returned, the single argument is the TITLE field.
  55.  
  56.     local($title) = @_;
  57.  
  58.     print "Content-type: text/html\n\n";
  59.     print "<html><head>\n";
  60.     print "<title>$title</title>\n";
  61.     print "</head>\n<body>\n";
  62. }
  63.  
  64. sub html_trailer {
  65.  
  66.     # subroutine html_trailer sends the trailing material to the HTML
  67.     # on STDOUT.
  68.  
  69.     local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  70.     = gmtime;
  71.  
  72.     local($mname) = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
  73.              "Aug", "Sep", "Oct", "Nov", "Dec")[$mon];
  74.     local($dname) = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
  75.              "Sat")[$wday]; 
  76.  
  77.     print "<p>\nGenerated by: <var>$0</var><br>\n";
  78.     print "Date: $hour:$min:$sec UT on $dname $mday $mname $year.<p>\n";
  79.     print "</body></html>\n";
  80. }
  81.  
  82. # --------- Everything above here is generic ---------
  83.  
  84. # Define fairly-constants
  85.  
  86.  
  87. #
  88. # Get the input, output header
  89. #
  90.  
  91. &get_request;
  92.  
  93.  
  94. #
  95. # make sure nobody tries to execute a subshell
  96. #
  97.  
  98. $rqpairs{'mailto'} =~ s/~!/ ~!/g;
  99.  
  100. #
  101. # check for REQUIRED keyword.  Set flag if value is required
  102. # but not provided, then put up a page and forget about sending
  103. # query.  The REQUIRED keyword was still used to insure a
  104. # key word entry. 
  105. #
  106.  
  107. @check_reqs = @names;
  108. for $i (0..$#check_reqs){
  109.     $name = shift(@check_reqs);
  110.     $value = shift(@check_reqs);
  111.  
  112.     if ($name =~ /REQUIRED/) {
  113.         if ($value eq "") {
  114.             $bad = $name;
  115.             $bad =~ s/\s*REQUIRED\s*//;
  116.         push(@missing, $bad);
  117.     }
  118.     }
  119. }
  120.  
  121.  
  122. if ($#missing >= 0) {
  123.     &html_header('Need More Inoformation Notice');
  124.     print "<H1>Missing Required Information</H1>\n";
  125.     print "<HR>\n";
  126.     print "<H3>Please provide values for the following:</H3>\n";
  127.     print "<UL>\n";
  128.     for $i (0..$#missing) {
  129.         $field = shift(@missing);
  130.         print "<LI> $field\n";
  131.     }
  132.     print "</UL>\n";
  133.     print "<applet code=delay.class width=596 height=75>";
  134.     print "<param name=img value=\"file:///tmp/httpd/.products/CDware/images/goto_home.gif\">";
  135.     print "<param name=del value=\"4000\">";
  136.     print "<param name=href value=\"http://localhost:7999/cgi-bin/req_more_info.pl?$rqpairs{'from'}+$rqpairs{'mailto'}\"></applet>";
  137.  
  138.     print "<HR>\n";
  139.     print "<H3>Go back and try again</H3>\n";
  140.  
  141.     &html_trailer;
  142.     exit 0;
  143. }
  144. #
  145. # check and set print method with file flag--fax or email
  146. #
  147. if ($rqpairs{'submit'} eq "fax") {
  148.      open (SUBMIT,">/tmp/httpd/fax_flag");
  149.      close (SUBMIT);
  150.  
  151. #
  152. # mail info 
  153. #
  154.  
  155. open (FILE, ">/tmp/httpd/info.$rqpairs{'submit'}");
  156.         print FILE  "\n";
  157.         print FILE  "   Catalyst CDware Product Information Request\n";
  158.         print FILE  "\n";
  159.              for $i (0..$#names){ 
  160.                 $name = shift(@names);
  161.              $value = shift(@names);
  162.  
  163.              $i++;
  164.              if ($i >= 5 && $name ne "" && $name ne "submit" ) {
  165.              print FILE "$name:  $value\n";
  166.              if ($name eq "Fax") { print FILE "\n"; break }   
  167.              }
  168.         }
  169.         print FILE  "\n";
  170.         print FILE  "Please send me more information on the following products:\n";
  171.         print FILE  "---------------------------------------------------------\n";
  172.         print FILE  "$rqpairs{'from'}\n";
  173.  
  174. close (FILE);
  175.  
  176.     print "Content-type: text/html\n\n";
  177.     print "<html><head>\n";
  178.     print "<title>Information Request Acknowledgement</title>\n";
  179.     print "</head>\n<body>\n";
  180.     print "<applet code=delay.class width=596 height=75>";
  181.     print "<param name=img value=\"file:///tmp/httpd/.products/CDware/images/cdwareban.gif\">";
  182.     print "<param name=del value=\"2200\">";
  183.     print "<param name=href value=\"http://localhost:7999/$rqpairs{'from'}/CDware.frame.html\"></applet>";
  184.     print "<p><p><center><hr>";
  185.     print "<p><h1>Your information has been saved for </h1>";
  186.     print "<p><h1>subsequent additional information requests.</h1>";
  187.     print "<hr><H2>It will be E-mailed/Printed out when you end your CDware session.</h2></center>";
  188. #    &html_trailer;
  189.  
  190.  
  191. exit 0;
  192.  
  193.